home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / nan_news / vol3 / no1 / editmemo.prg < prev    next >
Text File  |  1988-08-09  |  10KB  |  392 lines
  1. * Program:     EditMemo.PRG
  2. * Author:      Dennis L. Dias
  3. * Modified by: Don L. Powells
  4. * Version:     Clipper Summer '87
  5. * Notes:       Example of MEMOEDIT() with a UDF.
  6. * Copyright (c) 1987, 1988 Nantucket Corp.
  7.  
  8. PARAMETERS memofile
  9.  
  10. * If no file name was supplied on the command line use unnamed.
  11. IF PCOUNT() < 1
  12.     memofile = "unnamed"
  13. ENDIF
  14.  
  15. * Initialize variables and parameters
  16. prev_memo = ""    && Last memo file edited.
  17. ret_val = 0       && Return value sent to MEMOEDIT().
  18. deja_vu = .F.     && "Been here before" flag for init process.
  19. eresume = .F.     && Resume editing after Alt-W file write.
  20. altered = .F.     && Memofile has been altered.
  21.  
  22. t = 0
  23. l = 0
  24. b = 23
  25. r = 79
  26. update = .T.
  27. browse = .T.
  28. line_length = 132
  29. use_func = .T.
  30. ufunc = "mfunc"
  31. ins_on = .F.
  32. scrl_on = .F.
  33. word_wrap = .F.
  34. tabsize = 4
  35.  
  36. SET BELL ON
  37. SET SCOREBOARD OFF
  38.  
  39. * Continue editing until user exits or a Disk Write Error occurs.
  40. mexit = .F.
  41. DO WHILE !mexit
  42.    BEGIN SEQUENCE
  43.       IF !eresume
  44.          Config()
  45.          IF LASTKEY() = 27
  46.             @ b + 1, 79 SAY ""
  47.             mexit =.T.
  48.             BREAK
  49.          ENDIF
  50.          IF use_func
  51.             ufunc = "mfunc"
  52.             SET SCOREBOARD OFF
  53.          ELSE
  54.          IF browse
  55.             ufunc = ""
  56.          ELSE
  57.             ufunc = .F.
  58.          ENDIF
  59.          IF t = 0
  60.             SET SCOREBOARD OFF
  61.          ELSE
  62.             SET SCOREBOARD ON
  63.          ENDIF
  64.       ENDIF
  65.       IF !(prev_memo == memofile)
  66.          memofile = IIF(EMPTY(memofile),"unnamed",memofile)
  67.          usr_memo = MEMOREAD(memofile)
  68.          prev_memo = memofile
  69.          line_num = 1
  70.          col_num = 0
  71.          rel_row = 0
  72.          rel_col = 0
  73.          altered = .F.
  74.       ENDIF
  75.  
  76.       * User messages may start at the leftmost column and end
  77.       *   five spaces before the 'Line:' status message.
  78.       msg_len = r - l - 25
  79.  
  80.       * Draw screen constants
  81.       CLEAR SCREEN
  82.       @ t, l, b, r BOX "╒═╕│╛═╘│"
  83.       Saycenter(b,"<F1>: Key Reference")
  84.       @ b + 1, l SAY pad(LOWER(memofile), msg_len)
  85.    ENDIF
  86.  
  87.    init_count = 1
  88.    deja_vu = .F.
  89.    eresume = .F.
  90.  
  91.    usr_memo = MEMOEDIT(usr_memo, t + 1, l + 1, b - 1, r - 1,;
  92.                   update, ufunc,line_length, tabsize,;
  93.                   line_num, col_num, rel_row, rel_col)
  94.  
  95.    IF !memofile == "unnamed" .AND. !EMPTY(usr_memo) .AND.;
  96.                   ret_val = 23
  97.       altered = .F.
  98.       IF !MEMOWRIT(memofile, usr_memo)
  99.          SET COLOR TO w*+
  100.          @ 24,79 SAY ""
  101.          ? "DISK WRITE ERROR"
  102.          SET COLOR TO
  103.          CLOSE DATABASES
  104.          mexit = .T.
  105.          BREAK
  106.       ENDIF
  107.       @ b + 1, l SAY pad("Write successful.", msg_len)
  108.    ENDIF
  109.    END
  110. ENDDO
  111.  
  112.  
  113. *****
  114. * Mfunc() - MEMOEDIT user function
  115. *
  116. *    
  117.  
  118. FUNCTION Mfunc
  119.  
  120.    PARAMETERS mstatus, line, col
  121.    PRIVATE keypress
  122.  
  123.    ret_val = 0
  124.  
  125.    IF mstatus = 3
  126.       * Initialization
  127.       ret_val = InitStat()
  128.    ELSEIF mstatus = 0
  129.       * Idle status
  130.       request = IdleStat()
  131.    ELSE
  132.       * Keystroke exception
  133.       request = Keyexcep()
  134. ENDIF
  135. RETURN(ret_val)
  136.  
  137. *****
  138. * Pad()
  139. *
  140. * pad with spaces
  141.  
  142. FUNCTION Pad
  143.  
  144. PARAMETERS string, length
  145. RETURN SUBSTR(string + SPACE(length), 1, length)
  146.  
  147. *****
  148. * Config() - set parameters for simulation
  149. *
  150. *    
  151.  
  152. FUNCTION Config
  153.  
  154. memofile = pad(memofile, 64)
  155. CLEAR SCREEN
  156.  
  157. Saycenter(1,"CLIPPER TRAINING")
  158. Saycenter(2,"MEMOEDIT() DEMO")
  159. @ 3,0 SAY REPLICATE("─",80)
  160.  
  161. @ 5, 0 SAY "File To Edit_" GET memofile PICTURE "@K"
  162. Saycenter(4,"<PgDn>: Accept configuration  <ESC>: Exit to DOS")
  163. @ 8, 0 SAY "Window Coordinates:"
  164. @ 9, 5 SAY "Top_____________________" GET t
  165. @ 10, 5 SAY "Left____________________" GET l
  166. @ 11, 5 SAY "Bottom__________________" GET b
  167. @ 12, 5 SAY "Right___________________" GET r
  168.  
  169. @ 14, 5 SAY "Line Length (memowidth)_" GET line_length
  170. @ 15, 5 SAY "Tab Size________________" GET tabsize
  171.  
  172. @ 17, 5 SAY "Allow Updates [yn]______" GET update
  173. @ 18, 5 SAY "Allow Browse [yn]_______" GET browse
  174. @ 19, 5 SAY "Use User Function [yn]__" GET use_func
  175.  
  176. @ 21, 5 SAY "Insert Mode On [yn]_____" GET ins_on
  177. @ 22, 5 SAY "Scroll State On [yn]____" GET scrl_on
  178. @ 23, 5 SAY "Word Wrap On [yn]_______" GET word_wrap
  179. READ
  180.  
  181. memofile = ALLTRIM(memofile)
  182. RETURN(.T.)
  183.  
  184. *****
  185. * InitStat() - Initialization routine for MEMOEDIT()
  186. *
  187.  
  188. FUNCTION InitStat
  189.    * Initialization..global variables "init_count" and "deja_vu"
  190.    * control the initialization process..note that this is
  191.    * much simpler when the parameters passed to MEMOEDIT
  192.    * are known in advance (which is usually true).
  193.  
  194.    IF init_count = 1
  195.       * set initial insert mode
  196.       ins_mode = READINSERT()
  197.       IF (ins_on .AND. !ins_mode) .OR.;
  198.            (!ins_on .AND. ins_mode)
  199.          * toggle insert mode
  200.          ret_val = 22
  201.       ELSE
  202.          * insert mode correct
  203.          init_count = 2
  204.          @ b + 1, r - 25 SAY IF(ins_on, "I", " ")
  205.       ENDIF
  206.    ENDIF
  207.  
  208.    IF init_count = 2
  209.       * set initial scroll state (defaults ON if update OFF)
  210.       IF ((!scrl_on .AND. !update) .OR.;
  211.             (scrl_on .AND. update)) .AND. !deja_vu
  212.          * need to toggle
  213.          deja_vu = .T.
  214.          ret_val = 35
  215.       ELSE
  216.          * scroll state correct
  217.          init_count = 3
  218.          deja_vu = .F.
  219.          @ b + 1, r - 24 SAY IF(scrl_on, "S", " ")
  220.       ENDIF
  221.    ENDIF
  222.  
  223.    IF init_count = 3
  224.       * set initial word wrap..always defaults ON
  225.  
  226.       IF !word_wrap .AND. !deja_vu
  227.          * need to toggle
  228.          deja_vu = .T.
  229.          ret_val = 34
  230.       ELSE
  231.          * word wrap correct
  232.          init_count = 4
  233.          deja_vu = .F.
  234.          @ b + 1, r - 23 SAY IF(word_wrap, "W", " ")
  235.       ENDIF
  236.    ENDIF
  237.  
  238.    IF init_count = 4
  239.       * Finished initialization..note that if all defaults are
  240.       * correct we reach this point on the first call.
  241.       ret_val = 0
  242.    ENDIF
  243. RETURN(ret_val)
  244.  
  245. *****
  246. * IdleStat() - Process Idle status of MEMOEDIT()
  247. *
  248.  
  249. FUNCTION IdleStat
  250.    * Update Line and Col values
  251.    @ b + 1, r - 20 SAY "Line: " + pad(LTRIM(STR(line)), 4)
  252.    @ b + 1, r - 8 SAY "Col: " + pad(LTRIM(STR(col)), 3)
  253. RETURN(0)
  254.  
  255. *****
  256. * Keyexcep() - Process keystroke exceptions for MEMOEDIT()
  257. *
  258.  
  259. FUNCTION Keyexcep
  260.    keypress = LASTKEY()
  261.  
  262.    * save values to possibly resume edit
  263.    line_num = line
  264.    col_num = col
  265.    rel_row = ROW() - t - 1
  266.    rel_col = COL() - l - 1
  267.  
  268.    IF mstatus = 2
  269.       altered = .T.
  270.    ENDIF
  271.  
  272.    IF keypress = 23
  273.       * ^W..ignore (disable)
  274.       ret_val = 32
  275.    ELSEIF keypress = 273
  276.       * Alt-W..write file
  277.       IF !altered
  278.          * no changes to write
  279.          @ b + 1, l SAY pad("No changes to write.", msg_len)
  280.       ELSE
  281.          * write and resume
  282.          @ b + 1, l SAY SPACE(msg_len)
  283.          @ b + 1, l SAY "Writing " + LOWER(memofile) + "..."
  284.          ret_val = 23
  285.          eresume = .T.
  286.       ENDIF
  287.  
  288.    ELSEIF keypress = 301 .OR. keypress = 27
  289.       * Esc/Alt-X..exit
  290.       IF !altered
  291.          * no change
  292.          ret_val = 27
  293.       ELSE
  294.          * changes have been made to memo
  295.          @ b + 1, l SAY SPACE(msg_len)
  296.          @ b + 1, l SAY "Abandon [ynw]? "
  297.  
  298.          response = " "
  299.          DO WHILE !response $ "YNW"
  300.             response = UPPER(CHR(INKEY(0)))
  301.          ENDDO
  302.          @ b + 1, l SAY SPACE(msg_len)
  303.          IF response = "Y"
  304.             * abort
  305.             ret_val = 27
  306.          ELSEIF response = "N"
  307.             * ignore
  308.             ret_val = 32
  309.          ELSEIF response = "W"
  310.             * save and exit
  311.             @ b + 1, l SAY SPACE(msg_len)
  312.             @ b + 1, l SAY "Writing " + LOWER(memofile)+"..."
  313.             ret_val = 23
  314.          ENDIF
  315.       ENDIF
  316.    ELSEIF keypress = 289
  317.       * Alt-F..display file name
  318.       @ b + 1, l SAY pad(LOWER(memofile), msg_len)
  319.    ELSEIF keypress = 28
  320.       * F1..key reference
  321.       ret_val = Key_ref()
  322.    ELSEIF keypress = -2
  323.       * F3..delete line
  324.       ret_val = 25
  325.    ELSEIF keypress = -3
  326.       * F4..insert line
  327.       ret_val = 14
  328.    ELSEIF keypress = -4 .AND. update
  329.       * F5..toggle word wrap
  330.       word_wrap = !word_wrap
  331.       @ b + 1, r - 23 SAY IF(word_wrap, "W", " ")
  332.       ret_val = 34
  333.    ELSEIF keypress = -5
  334.       * F6..toggle scroll lock
  335.       scrl_on = !scrl_on
  336.       @ b + 1, r - 24 SAY IF(scrl_on, "S", " ")
  337.       ret_val = 35
  338.    ELSEIF keypress = -6
  339.       * F7..insert a form feed in the text
  340.       KEYBOARD CHR(12)
  341.       ret_val = 32
  342.    ELSEIF (keypress = 279 .OR. keypress = 22) .AND. update
  343.       * ^V/Ins/Alt-I..toggle insert mode
  344.       ins_on = !ins_on
  345.       @ b + 1, r - 25 SAY IF(ins_on, "I", " ")
  346.       ret_val = 22
  347.    ENDIF
  348. RETURN(ret_val)
  349.  
  350. *****
  351. * Key_ref() - Key Reference Chart
  352. *
  353.  
  354. FUNCTION Key_ref
  355.    PRIVATE mrow,mcol,ref_scrn
  356.    ref_scrn = SAVESCREEN(4,22,20,59)
  357.    @ 4,22 TO 18,59 DOUBLE
  358.    @ 4,24 SAY "Key Reference"
  359.    @ 18,24 SAY "Press <ESC> when done."
  360.    mrow = 6
  361.    mcol = 24
  362.    SET CURSOR OFF
  363.    @ mrow,mcol SAY "^W..ignore (disable)"
  364.    @ ROW() + 1, mcol SAY  "Alt-W..write file"
  365.    @ ROW() + 1, mcol SAY  "Esc/Alt-X..exit"
  366.    @ ROW() + 1, mcol SAY  "Alt-F..display file name"
  367.    @ ROW() + 1, mcol SAY  "F1..key reference"
  368.    @ ROW() + 1, mcol SAY  "F3..delete line"
  369.    @ ROW() + 1, mcol SAY  "F4..insert line"
  370.    @ ROW() + 1, mcol SAY  "F5..toggle word wrap"
  371.    @ ROW() + 1, mcol SAY  "F6..toggle scroll lock"
  372.    @ ROW() + 1, mcol SAY  "F7..insert a form feed in the text"
  373.    @ ROW() + 1, mcol SAY  "^V/Ins/Alt-I..toggle insert mode"
  374.    INKEY(0)
  375.    SET CURSOR ON
  376.    RESTSCREEN(4,22,20,59,ref_scrn)
  377. RETURN(0)
  378.  
  379. *****
  380. * Saycenter() - Function to center a string on a given row.
  381. * Usage: Saycenter(row#,expC)
  382. *
  383.  
  384. FUNCTION Saycenter
  385.    PARAMETERS trow,in_string
  386.    IF LEN(in_string)>=80
  387.       @ trow,0 SAY in_string
  388.    ELSE
  389.       @ trow,(80 - LEN(in_string))/2 SAY in_string
  390.    ENDIF
  391. RETURN (.T.)
  392.